Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/gif2bmpa/code/webpaper/gif2bmp.pas

Pascal/Delphi Source File | 1995-12-22 | 26.5 KB | 789 lines

unit Gif2Bmp;
{
 Gif to Bmp a free gif to Bmp conversion routine.
 Converted to Delphin Pascal by Richard Dominelli May 1995

 Change this code anyway you would like it is free.  Version 2.0 is in
 the works which will use an assembly lzw decoder.  Any suggested
 improvements are very welcome.

 Any comments or questions please write me at one of the following addresses.

 [e-mail]
 [e-mail]
 73541,2555 on Compuserve.

 I Hope you find this usefull.

 Rich

 Gif2Bmp was based on and would not have been possible without...

 GifUtl .pas - (c)Copyright 1993 Sean Wenzel

 Sean Writes :
    Users are given the right to use/modify and distribute this source code as
    long as credit is given where due.  I would also ask that anyone who makes
    use of this source/program drop me a line at my CompuServe address of
    71736,1245.  Just curious...

Revision History

Version        date        Comment
1.1            6/1/1995    Added better error handling and exceptions for conditions
                        which previously caused GPF's

1.2            7/31/1995    Fix pallete problem on 256 color gifs.  Windows
                        Bitmaps are stored with 4 bytes per pallet entry. 4th
                        byte is ignored.



}


{$R-}   {       range checking off }  { Put them on if you like but it slows down the}
{$S-} { stack checking off }  { decoding  (almost doubles it!) }
{$I-} { i/o checking off }

interface

uses WinTypes,Forms,ExtCtrls,SysUtils,Classes,Gauges;

{===============================================================
   Gif Records and Structs
===============================================================}

type
    TDataSubBlock = record
        Size: byte;     { size of the block -- 0 to 255 }
        Data: array[1..255] of byte; { the data }
    end;

const
    BlockTerminator: byte = 0; { terminates stream of data blocks }

type
    THeader = record
        Signature: array[0..2] of char; { contains 'GIF' }
        Version: array[0..2] of char;   { '87a' or '89a' }
    end;

    TLogicalScreenDescriptor = record
        ScreenWidth: word;              { logical screen width }
        ScreenHeight: word;  { logical screen height }
        PackedFields: byte;     { packed fields - see below }
        BackGroundColorIndex: byte;     { index to global color table }
        AspectRatio: byte;      { actual ratio = (AspectRatio + 15) / 64 }
    end;

const
{ logical screen descriptor packed field masks }
    lsdGlobalColorTable = $80;  { set if global color table follows L.S.D. }
    lsdColorResolution = $70;               { Color resolution - 3 bits }
    lsdSort = $08;                                                  { set if global color table is sorted - 1 bit }
    lsdColorTableSize = $07;                { size of global color table - 3 bits }
                                                            { Actual size = 2^value+1    - value is 3 bits }

type
    TColorItem = record     { one item a a color table }
        Red: byte;
        Green: byte;
        Blue: byte;
    end;

    TColorTable = array[0..255] of TColorItem;      { the color table }

const
    ImageSeperator: byte = $2C;

type
    TImageDescriptor = record
        Seperator: byte;                         { fixed value of ImageSeperator }
        ImageLeftPos: word; {Column in pixels in respect to left edge of logical screen }
        ImageTopPos: word;{row in pixels in respect to top of logical screen }
        ImageWidth: word;       { width of image in pixels }
        ImageHeight: word;      { height of image in pixels }
        PackedFields: byte; { see below }
    end;
const
    { image descriptor bit masks }
        idLocalColorTable = $80; { set if a local color table follows }
        idInterlaced = $40;                      { set if image is interlaced }
        idSort = $20;                                            { set if color table is sorted }
        idReserved = $0C;                                { reserved - must be set to $00 }
        idColorTableSize = $07;  { size of color table as above }

    Trailer: byte = $3B;    { indicates the end of the GIF data stream }

{ other extension blocks not currently supported by this unit
    - Graphic Control extension
    - Comment extension           I'm not sure what will happen if these blocks
    - Plain text extension        are encountered but it'll be interesting
    - application extension }

const
    ExtensionIntroducer: byte = $21;
    MAXSCREENWIDTH = 800;

type
    TExtensionBlock = record
        Introducer: byte;                               { fixed value of ExtensionIntroducer }
        ExtensionLabel: byte;
        BlockSize: byte;
    end;

    PCodeItem = ^TCodeItem;
    TCodeItem = record
        Code1, Code2: byte;
    end;
{===============================================================}
{    Bitmap File Structs
{===============================================================}

type
   GraphicLine = array [0..2048] of byte;
   PBmLine = ^TBmpLinesStruct;
    TBmpLinesStruct = record
        LineData : GraphicLine;
        LineNo : LongInt;
    end;
{===============================================================}




const
    MAXCODES = 4095;        { the maximum number of different codes 0 inclusive }



type
    { This is the actual gif object }
    PGif = ^TGif;
    TGif = class(TObject)
        Stream: TMemoryStream;{PBufStream;}  { the file stream for the gif file }
        Header: THeader;               { gif file header }
        LogicalScreen: TLogicalScreenDescriptor;  { gif screen descriptor }
        GlobalColorTable: TColorTable;            { global color table }
        LocalColorTable: TColorTable;             { local color table }
        ImageDescriptor: TImageDescriptor;        { image descriptor }
        UseLocalColors: boolean;                  { true if local colors in use }
        Interlaced: boolean;                                    { true if image is interlaced }
        LZWCodeSize: byte;                                       { minimum size of the LZW codes in bits }
        ImageData: TDataSubBlock;                { variable to store incoming gif data }
        TableSize: word;                                                 { number of entrys in the color table }
        BitsLeft, BytesLeft: integer;{ bits left in byte - bytes left in block }
        BadCodeCount: word;          { bad code counter }
        CurrCodeSize: integer;       { Current size of code in bits }
        ClearCode: integer;          { Clear code value }
        EndingCode: integer;         { ending code value }
        Slot: word;                                     { position that the next new code is to be added }
        TopSlot: word;      { highest slot position for the current code size }
        HighCode: word;     { highest code that does not require decoding }
        NextByte: integer;      { the index to the next byte in the datablock array }
        CurrByte: byte;                 { the current byte }
        DecodeStack: array[0..MAXCODES] of byte; { stack for the decoded codes }
        Prefix: array[0..MAXCODES] of word;                     { array for code prefixes }
        Suffix: array[0..MAXCODES] of byte;             { array for code suffixes }
        LineBuffer: GraphicLine; { array for buffer line output }
        CurrentX, CurrentY: integer;                                            { current screen locations }
        Status: word;
        InterlacePass: byte;    { interlace pass number }
        {Conversion Routine Vars}
        Gauge : TGauge;
        Stat  : TPanel;                              { status of the decode }
        ProgFlag : boolean;
        BmHeader : TBitmapInfoHeader; {File Header for bitmap file}
        ImageLines : TList; {Image data}
        {Member Functions}
        constructor Create;
        destructor Destroy; virtual;

        procedure SetIndicators(MyGauge :TGauge; MyStat : TPanel); {On going status indicators}
        procedure WriteBitmap(ABMPName:string); {Writes out the header info
                                           writes out the pallet in correct order.
                                           Arranges the lines in correct order.
                                           Writes out the image lines in correct order}

        procedure Error(What: integer);
        procedure InitCompressionStream;        { initializes info for decode }
        procedure ReadSubBlock;                          { reads a data subblock from the stream }
        procedure Decode(Beep: boolean);        { the actual LZW decoding routine }
        procedure CreateLine;

        function Convert(AGifName,ABmpName:string):integer; {Converts gif file to bmp file}
        function GifConvert(ABmpName:string):integer; {Converts gif to bmp}
        function CreateBitHeader:integer; {Takes the gif header information and converts it to BMP}

        function ConvertfromMem(AMemStream:TMemoryStream;ABmpName:string):integer;
        function ParseMem:integer;
        function NextCode: word;                                        { returns the next available code }
    end;


const
{ error constants }
    geNoError = 0;                          { no errors found }
    geNoFile = 1;         { gif file not found }
    geNotGIF = 2;         { file is not a gif file }
    geNoGlobalColor = 3;  { no Global Color table found }
    geImagePreceded = 4;  { image descriptor preceeded by other unknown data }
    geEmptyBlock = 5;                       { Block has no data }
     geUnExpectedEOF = 6;  { unexpected EOF }
    geBadCodeSize = 7;    { bad code size }
    geBadCode = 8;                          { Bad code was found }
    geBitSizeOverflow = 9; { bit size went beyond 12 bits }

implementation


function Power(A, N: real): real;       { returns A raised to the power of N }
begin
    Power := exp(N * ln(A));
end;


{ TGif }
constructor TGif.Create;
begin
       {Create Memory Buffer to hold gif}
        Stream := TMemoryStream.Create;
        ImageLines := TList.Create;
        ProgFlag := false;
end;


destructor TGif.Destroy;
begin
    if Stream <> nil then
        Dispose(Stream);
end;

procedure TGif.SetIndicators(MyGauge :TGauge; MyStat : TPanel);
begin
     ProgFlag := true;
     Gauge := MyGauge;
     Stat := MyStat;
end;

function TGif.Convert(AGifName, ABmpName:string):integer;
var
   nRet   : integer;
begin

    if Pos('.',AGifName) = 0 then     { if the filename has no extension add one }
        AGifName := AGifName + '.gif';

     Stream.LoadFromFile(AGifName); {Load the file into memory}
     nRet := GifConvert(ABmpName);

end;

function TGif.GifConvert(ABmpName:string) : integer;
label Bottom;
var
   nRet : integer;
begin

     nRet := 0;

     if ProgFlag then
        Stat.Caption := 'Parsing Gif file...';

     {Parses the gif file already in memory}
     nRet := ParseMem;
     if (nRet<>0) then
        goto Bottom;

     if ProgFlag then
     begin
        Gauge.MaxValue := (ImageDescriptor.ImageHeight*2)+10;
        Gauge.Progress := 5;
        Stat.Caption := 'Creating Bitmap header...';
     end;

     {Create the bitmap header info}

     nRet := CreateBitHeader;
     if (nRet<>0) then
        goto Bottom;

     if ProgFlag then
     begin
        Gauge.Progress := 10;
        Stat.Caption := 'Decoding Gif...';
     end;

     {Decode the gif.}
     try
         Decode(TRUE);
         except on EGPFault do
         begin
              nRet := geNotGif;
         end;
     end;

     if (nRet <> 0) then
          Goto Bottom;

     if ProgFlag then
          Stat.Caption := 'Writing '+ABmpName+'...';
     WriteBitmap(ABmpName);

Bottom:
    GifConvert := nRet;
end;


function TGif.ConvertfromMem(AMemStream:TMemoryStream;ABmpName:string):integer;
var
   nRet :  integer;
begin
     if ProgFlag then
        Stat.Caption := 'Loading Gif file...';
     Stream.LoadFromStream(AMemStream);
     GifConvert(ABmpName);
end;



procedure TGif.Error(What: integer);
begin
    Status := What;
end;


{Decodes the header and palete info}
function TGif.ParseMem : integer;
label Bottom;
begin
    Stream.Read(Header, sizeof(Header)); { read the header }

    {Stupid validation tricks}
    if Header.Signature <> 'GIF' then
   begin
      ParseMem :=geNotGif;   { is vaild signature }
      goto Bottom;
   end;

    {Decode the header information}
    Stream.Read(LogicalScreen, sizeof(LogicalScreen));

    if LogicalScreen.PackedFields and lsdGlobalColorTable = lsdGlobalColorTable then
    begin
        TableSize := trunc(Power(2,(LogicalScreen.PackedFields and lsdColorTableSize)+1));
        Stream.Read(GlobalColorTable, TableSize*sizeof(TColorItem)); { read Global Color Table }
    end
    else
   begin
        ParseMem := geNoGlobalColor;
      goto Bottom;
   end;
    {Done with Global Headers}

    {Image specific headers}
    Stream.Read(ImageDescriptor, sizeof(ImageDescriptor)); { read image descriptor }

    {Decode image header info}
    if ImageDescriptor.Seperator <> ImageSeperator then                     { verify that it is the descriptor }
   begin
        ParseMem := geImagePreceded;
      goto Bottom;
   end;

    {Check for local color table}
    if ImageDescriptor.PackedFields and idLocalColorTable = idLocalColorTable then
    begin                                                               { if local color table }
        TableSize := trunc(Power(2,(ImageDescriptor.PackedFields and idColorTableSize)+1));
        Stream.Read(LocalColorTable, TableSize*sizeof(TColorItem)); { read Local Color Table }
        UseLocalColors := True;
    end
    else
        UseLocalColors := false;

    {Check for interlaced}
    if ImageDescriptor.PackedFields and idInterlaced = idInterlaced then
    begin
        Interlaced := true;
        InterlacePass := 0;
    end;
    {End of image header stuff}

    {Reset then Expand capacity of the Image Lines list}
    ImageLines.Clear;
    {Note if you ever find a gif more than 16k pixels tall this will puke}
    ImageLines.Capacity := ImageDescriptor.ImageHeight;

    if (Stream = nil) then{ check for stream error }
   begin
        ParseMem := geNoFile;
      goto Bottom;
   end;

    ParseMem := 0;
Bottom:
end;

procedure TGif.InitCompressionStream;
var
    I: integer;
begin
    {InitGraphics;}                           { Initialize the graphics display }
    Stream.Read(LZWCodeSize, sizeof(byte));{ get minimum code size }
    if not (LZWCodeSize in [2..9]) then     { valid code sizes 2-9 bits }
        Error(geBadCodeSize);

    CurrCodeSize := succ(LZWCodeSize); { set the initial code size }
    ClearCode := 1 shl LZWCodeSize;    { set the clear code }
    EndingCode := succ(ClearCode);     { set the ending code }
    HighCode := pred(ClearCode);                     { set the highest code not needing decoding }
    BytesLeft := 0;                    { clear other variables }
    BitsLeft := 0;
    CurrentX := 0;
    CurrentY := 0;
end;

procedure TGif.ReadSubBlock;
begin
    Stream.Read(ImageData.Size, sizeof(ImageData.Size)); { get the data block size }
    if ImageData.Size = 0 then Error(geEmptyBlock); { check for empty block }
    Stream.Read(ImageData.Data, ImageData.Size);   { read in the block }
    NextByte := 1;                                  { reset next byte }
    BytesLeft := ImageData.Size;                                                                            { reset bytes left }
end;

const
    CodeMask: array[0..12] of longint = (  { bit masks for use with Next code }
        0,
        $0001, $0003,
        $0007, $000F,
        $001F, $003F,
        $007F, $00FF,
        $01FF, $03FF,
        $07FF, $0FFF);

function TGif.NextCode: word; { returns a code of the proper bit size }
var
    Ret: longint;                           { temporary return value }
begin
    if BitsLeft = 0 then                                                                            { any bits left in byte ? }
    begin                                   { any bytes left }
        if BytesLeft <= 0 then                                                          { if not get another block }
            ReadSubBlock;
        CurrByte := ImageData.Data[NextByte]; { get a byte }
        inc(NextByte);                        { set the next byte index }
        BitsLeft := 8;                        { set bits left in the byte }
        dec(BytesLeft);                       { decrement the bytes left counter }
    end;
    ret := CurrByte shr (8 - BitsLeft);                     { shift off any previosly used bits}
    while CurrCodeSize > BitsLeft do        { need more bits ? }
    begin
        if BytesLeft <= 0 then                                                          { any bytes left in block ? }
            ReadSubBlock;                       { if not read in another block }
        CurrByte := ImageData.Data[NextByte]; { get another byte }
        inc(NextByte);                        { increment NextByte counter }
        ret := ret or (CurrByte shl BitsLeft);{ add the remaining bits to the return value }
        BitsLeft := BitsLeft + 8;                                               { set bit counter }
        dec(BytesLeft);                     { decrement bytesleft counter }
    end;
    BitsLeft := BitsLeft - CurrCodeSize;  { subtract the code size from bitsleft }
    ret := ret and CodeMask[CurrCodeSize];{ mask off the right number of bits }
    NextCode := ret;
end;

{ this procedure initializes the graphics mode and actually decodes the
    GIF image }
procedure TGif.Decode(Beep: boolean);
var
    SP: integer; { index to the decode stack }

{ local procedure that decodes a code and puts it on the decode stack }
procedure DecodeCode(var Code: word);
begin
    while Code > HighCode do { rip thru the prefix list placing suffixes }
    begin                    { onto the decode stack }
        DecodeStack[SP] := Suffix[Code]; { put the suffix on the decode stack }
        inc(SP);                         { increment decode stack index }
        Code := Prefix[Code];            { get the new prefix }
    end;
    DecodeStack[SP] := Code;        { put the last code onto the decode stack }
    inc(SP);                                                                        { increment the decode stack index }
end;

var
    TempOldCode, OldCode: word;
    BufCnt: word;           { line buffer counter }
    Code, C: word;
    CurrBuf: word;  { line buffer index }
begin
    InitCompressionStream;    { Initialize decoding paramaters }
    OldCode := 0;
    SP := 0;
    BufCnt := ImageDescriptor.ImageWidth; { set the Image Width }
    CurrBuf := 0;

    C := NextCode;                                          { get the initial code - should be a clear code }
    while C <> EndingCode do  { main loop until ending code is found }
    begin
        if C = ClearCode then   { code is a clear code - so clear }
        begin
            CurrCodeSize := LZWCodeSize + 1;{ reset the code size }
            Slot := EndingCode + 1;                                 { set slot for next new code }
            TopSlot := 1 shl CurrCodeSize;  { set max slot number }
            while C = ClearCode do
                C := NextCode;                  { read until all clear codes gone - shouldn't happen }
            if C = EndingCode then
            begin
                Error(geBadCode);   { ending code after a clear code }
                break;                                                  { this also should never happen }
            end;
            if C >= Slot { if the code is beyond preset codes then set to zero }
                then c := 0;
            OldCode := C;
            DecodeStack[sp] := C;                                   { output code to decoded stack }
            inc(SP);                                               { increment decode stack index }
        end
        else   { the code is not a clear code or an ending code so it must }
        begin  { be a code code - so decode the code }
            Code := C;
            if Code < Slot then     { is the code in the table? }
            begin
                DecodeCode(Code);                                       { decode the code }
                if Slot <= TopSlot then
                begin                                { add the new code to the table }
                    Suffix[Slot] := Code;                   { make the suffix }
                    PreFix[slot] := OldCode;        { the previous code - a link to the data }
                    inc(Slot);                                                              { increment slot number }
                    OldCode := C;                                                   { set oldcode }
                end;
                if Slot >= TopSlot then { have reached the top slot for bit size }
                begin                   { increment code bit size }
                    if CurrCodeSize < 12 then { new bit size not too big? }
                    begin
                        TopSlot := TopSlot shl 1;       { new top slot }
                        inc(CurrCodeSize)                                       { new code size }
                    end
                    else
                        Error(geBitSizeOverflow); { encoder made a boo boo }
                end;
            end
            else
            begin           { the code is not in the table }
                if Code <> Slot then                    { code is not the next available slot }
                    Error(geBadCode);  { so error out }

                { the code does not exist so make a new entry in the code table
                 and then translate the new code }
                TempOldCode := OldCode;  { make a copy of the old code }
                while OldCode > HighCode do { translate the old code and place it }
                begin                                   { on the decode stack }
                    DecodeStack[SP] := Suffix[OldCode]; { do the suffix }
                    OldCode := Prefix[OldCode];         { get next prefix }
                end;
                DecodeStack[SP] := OldCode;     { put the code onto the decode stack }
                                                                        { but DO NOT increment stack index }
                { the decode stack is not incremented because because we are only
                    translating the oldcode to get the first character }
                if Slot <= TopSlot then
                begin                 { make new code entry }
                    Suffix[Slot] := OldCode;                 { first char of old code }
                    Prefix[Slot] := TempOldCode; { link to the old code prefix }
                    inc(Slot);                   { increment slot }
                end;
                if Slot >= TopSlot then { slot is too big }
                begin                   { increment code size }
                    if CurrCodeSize < 12 then
                    begin
                        TopSlot := TopSlot shl 1;       { new top slot }
                        inc(CurrCodeSize)                                       { new code size }
                    end
                    else
                        Error(geBitSizeOverFlow);
                end;
                DecodeCode(Code); { now that the table entry exists decode it }
                OldCode := C;     { set the new old code }
            end;
        end;
        { the decoded string is on the decode stack so pop it off and put it
         into the line buffer }
        while SP > 0 do
        begin
            dec(SP);
            LineBuffer[CurrBuf] := DecodeStack[SP];
            inc(CurrBuf);
            dec(BufCnt);
            if BufCnt = 0 then  { is the line full ? }
            begin
                CreateLine;
                CurrBuf := 0;
                BufCnt := ImageDescriptor.ImageWidth;
            end;
        end;
    C := NextCode;  { get the next code and go at is some more }
    end;            { now that wasn't all that bad was it? }
end;

function TGif.CreateBitHeader:integer;
{ This routine takes the values from the gif image
  descriptor and fills in the appropriate values in the
  bit map header struct.
}
begin
    BmHeader.biSize := Sizeof(TBitmapInfoHeader);
    BmHeader.biWidth := ImageDescriptor.ImageWidth;
    BmHeader.biHeight := ImageDescriptor.ImageHeight;
    BmHeader.biPlanes := 1; {Arcane and rarely used}
    BmHeader.biBitCount := 8; {Hmmm Should this be hardcoded ?}
    BmHeader.biCompression := BI_RGB; {Sorry Did not implement compression in this version}
    BmHeader.biSizeImage := 0; {Valid since we are not compressing the image}
    BmHeader.biXPelsPerMeter :=143; {Rarely used very arcane field}
    BmHeader.biYPelsPerMeter :=143; {Ditto}
    BmHeader.biClrUsed := 0; {all colors are used}
    BmHeader.biClrImportant := 0; {all colors are important}
   CreateBitHeader := 0;
end;

{fills in Line list with current line}
procedure TGif.CreateLine;
var
    I: integer;
   p: PBmLine;
   prog: integer;
begin

   Application.ProcessMessages;
   {Create a new bmp line}
   New(p);

   {Fill in the data}
   p^.LineData := LineBuffer;
   p^.LineNo := CurrentY;
   if ProgFlag then
   begin
       prog := Gauge.Progress + 1;
       Gauge.Progress:=prog;
   end;
   {Add it to the list of lines}
   ImageLines.Add(p);

   {Prepare for the next line}
    inc(CurrentY);

    if InterLaced then     { Interlace support }
    begin
        case InterlacePass of
            0: CurrentY := CurrentY + 7;
            1: CurrentY := CurrentY + 7;
            2: CurrentY := CurrentY + 3;
            3: CurrentY := CurrentY + 1;
        end;

        if CurrentY >= ImageDescriptor.ImageHeight then
        begin
            inc(InterLacePass);
            case InterLacePass of
                1: CurrentY := 4;
                2: CurrentY := 2;
                3: CurrentY := 1;
            end;
        end;
    end;
end;

procedure TGif.WriteBitmap(ABMPName:string);
var
mp:TMemoryStream;
fp:TFileStream;
BitFile: TBitmapFileHeader;
i:integer;
Line:integer;
ch:char;
p:PBmLine;
prog : integer;
begin

BitFile.bfSize := (3*255) + {Color map info}
                  sizeof(TBitmapFileHeader) +
                  sizeof(TBitmapInfoHeader) +
                  (ImageDescriptor.ImageHeight*ImageDescriptor.ImageWidth);

BitFile.bfReserved1 := 0; {not currently used}
BitFile.bfReserved2 := 0; {not currently used}
BitFile.bfOffBits := (4*256)+
                     sizeof(TBitmapFileHeader)+
                     sizeof(TBitmapInfoHeader);

{Create a memory stream to build the bm into}
mp := TMemoryStream.Create;

{Write the file header}
ch:='B';
mp.Write(ch,1);
ch:='M';
mp.Write(ch,1);
mp.Write(BitFile.bfSize,sizeof(BitFile.bfSize));
mp.Write(BitFile.bfReserved1,sizeof(BitFile.bfReserved1));
mp.Write(BitFile.bfReserved2,sizeof(BitFile.bfReserved2));
mp.Write(BitFile.bfOffBits,sizeof(BitFile.bfOffBits));

{Write the bitmap image header info}
mp.Write(BmHeader,sizeof(BmHeader));

{if false then
begin}
    {Write the BGR palete inforamtion to this file}
    if UseLocalColors then {Use the local color table}
    begin
         for i:=0 to 255 do
         begin
                mp.Write(LocalColorTable[i].Blue,1);
                mp.Write(LocalColorTable[i].Green,1);
                mp.Write(LocalColorTable[i].Red,1);
                mp.Write(ch,1); {Bogus palete entry required by windows}
         end;
    end
    else {Use the global table}
    begin
         for i:=0 to 255 do
         begin
                mp.Write(GlobalColorTable[i].Blue,1);
                mp.Write(GlobalColorTable[i].Green,1);
                mp.Write(GlobalColorTable[i].Red,1);
                mp.Write(ch,1); {Bogus palete entry required by windows}
         end;
    end;
{end;}

{Init the Line Counter}
Line := ImageDescriptor.ImageHeight;
{Write out File lines in reverse order}
while Line >= 0 do
begin
    {Go through the line list in reverse order looking for the
    current Line. Use reverse order since non interlaced gifs are
    stored top to bottom.  Bmp file need to be written bottom to
    top}
    for i:= (ImageLines.Count-1) downto 0  do
    begin
        if ProgFlag then
        begin
            prog := Gauge.Progress + 1;
            Gauge.Progress:=prog;
        end;
         p := ImageLines.Items[i];
         if p^.LineNo = Line then
         begin
              mp.Write(p^.LineData,ImageDescriptor.ImageWidth);
              break;
         end;
    end;
    dec(Line);
end;

mp.SaveToFile(ABMPName);
mp.Free;
end;

end.